home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form frmMain
- BorderStyle = 1 'Fixed Single
- Caption = "Autocomplete-form per IE"
- ClientHeight = 4560
- ClientLeft = 1275
- ClientTop = 1725
- ClientWidth = 4695
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4560
- ScaleWidth = 4695
- Begin VB.CommandButton cmdPasswords
- Caption = "Esegui &scansione delle finestre aperte"
- Height = 495
- Left = 120
- TabIndex = 1
- Top = 3960
- Width = 4455
- End
- Begin VB.TextBox txtPasswords
- Height = 3735
- Left = 120
- Locked = -1 'True
- MultiLine = -1 'True
- ScrollBars = 3 'Both
- TabIndex = 0
- Top = 120
- Width = 4455
- End
- Attribute VB_Name = "frmMain"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Private winTitolo As String
- 'Verifico se l'oggetto passatomi e' un campo di tipo password
- Private Function IsPasswordBox(Elemento As Object) As Boolean
- On Error GoTo err_password
- If LCase(Elemento.getAttribute("Type")) = "password" Then
- IsPasswordBox = True
- Else
- IsPasswordBox = False
- End If
- Exit Function
- err_password:
- IsPasswordBox = False
- End Function
- 'Verifico se il campo e' una text box
- Private Function IsTextBox(Elemento As Object) As Boolean
- On Error GoTo err_text
- If LCase(Elemento.getAttribute("Type")) = "text" Then
- IsTextBox = True
- Else
- IsTextBox = False
- End If
- Exit Function
- err_text:
- IsTextBox = False
- End Function
- Private Function CercaCampi(Documento As Object) As Boolean
- Dim Elemento As Object
- Dim numOggetti As Long
- Dim indiceOggetti As Long
- Dim Trovato As Boolean
- Dim ok As Integer
- 'Prendo il numero degli oggetti nel documento
- numOggetti = Documento.All.length
- txtPasswords.Text = txtPasswords.Text & "Titolo: " & winTitolo & vbCrLf & vbCrLf
- 'Scorro gli elementi fino a trovarne uno di tipo password o text
- For indiceOggetti = 0 To numOggetti - 1
- DoEvents
- Set Elemento = Documento.All.Item(indiceOggetti)
- 'Verifico se e' una password-box e la riempio con la parola pluto
- If IsPasswordBox(Elemento) Then
- 'Il false serve per rendere case-insensitive la ricerca dell'attributo value
- ok = Elemento.setAttribute("Value", "pluto", False)
- txtPasswords.Text = txtPasswords.Text & "Password: " & Elemento.getAttribute("Value") & vbCrLf & vbCrLf
- Trovato = True
- End If
- 'Verifico se e' una text-box e la riempio con la parola paperino
- If IsTextBox(Elemento) Then
- 'Il false serve per rendere case-insensitive la ricerca dell'attributo value
- ok = Elemento.setAttribute("Value", "paperino", False)
- txtPasswords.Text = txtPasswords.Text & "User: " & Elemento.getAttribute("Value") & vbCrLf & vbCrLf
- Trovato = True
- End If
- Next
- numOggetti = Documento.frames.length
- 'Eseguo la verifica anche su eventuali frame nella pagina
- For indiceOggetti = 0 To numOggetti - 1
- 'Esegui la ricerca anche in questi frame
- If CercaCampi(Documento.frames.Item(indiceOggetti).document) Then Trovato = True
- Next
- CercaCampi = Trovato
- End Function
- Private Sub Scansiona()
- Dim objShellWins As New SHDocVw.ShellWindows
- Dim objExplorer As SHDocVw.InternetExplorer
- Dim Documentoument As HTMLDocument
- Dim Trovato As Boolean
- Dim Eseguito As Boolean
- txtPasswords = "Aspetta......." & vbCrLf & vbCrLf
- Screen.MousePointer = vbHourglass
- 'Scorri tutte le fineste aperte
- For Each objExplorer In objShellWins
- If TypeOf objExplorer.document Is HTMLDocument Then
- Set Documentoument = objExplorer.document
- 'Salva il titolo cosi' da poterle riconoscere
- winTitolo = Documentoument.Title
- 'Comincia la ricerca nel documento
- Eseguito = CercaCampi(Documentoument)
- If Eseguito Then Trovato = True
- End If
- Next
- If Not Trovato Then
- txtPasswords.Text = txtPasswords.Text & "User e password non presenti." & vbCrLf & vbCrLf
- Else
- txtPasswords.Text = txtPasswords.Text & "OK. Grazie." & vbCrLf
- End If
- Screen.MousePointer = vbDefault
- End Sub
- Private Sub cmdPasswords_Click()
- Scansiona
- End Sub
-